home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
LANG
/
FORTH
/
FORTHMAC
/
OLD
/
TOOLS1
/
!Forthmacs.lib.sort
< prev
next >
Wrap
Text File
|
1996-05-27
|
4KB
|
97 lines
\ Heap Sort
\
\ Input:
\ Array of records, indexed from 1 to #records. Array index 0
\ refers to an extra record location which is used as a temporary.
\ The arrays can be in any format you choose, so long as you
\ provide appropriate rec-copy and rec-test routines.
\
\ You must provide implementations for these deferred words:
\ rec-copy ( i j -- ) \ Copies a record from position i to j
\ rec-test ( i j -- flag ) \ True if record(i) is > record(j)
\ For both of these functions, if either index i or j is 0, then the
\ temporary record location is used.
\
\ Output:
\ The array from 1 to #records is left sorted in ascending order
\ according to the comparison function rec-test .
\
\ See forth/test.dir/test-sort.f for an example use.
\ Discussion:
\ Heap sort is a very clever sorting algorithm, with some nice properties:
\ 1) The sort is done in-place. Only one extra record location is required.
\ 2) The worst-case complexity is O(n log n)
\ Drawbacks:
\ 1) The inner loop requires 2 comparisons.
\ 2) The order of input records with duplicate keys is not necessarily
\ preserved in the sorted output.
\ 3) The algorithm is not intuitive. Consult a sorting (e.g. Knuth Vol.3)
\ or data structures (e.g. Horowitz and Sahni) text for more information.
\
\ As used here, a heap is a binary tree with the following property:
\ Each node is greater than or equal to either of its children.
\ Note that a heap is not necessarily completely sorted, because no ordering
\ is imposed between siblings. Furthermore, it is possible that the children
\ of a node might be greater than the node's brother.
\
\ The algorithm relies on a clever representation of a heap as an array.
\ No tree pointers are necessary, because the heap is a bushy tree: every
\ level except the last is completely populated. This yields the following
\ representation: Node 1 is the root of the tree. Nodes 2 and 3 are the
\ level 1 siblings, nodes 4 5 6 and 7 are the level 2 siblings, etc.
\ This allows you to traverse the tree with 2* , 2/ , and 1+ .
defer rec-copy ( i j -- ) \ Copies record from position i to position j
defer rec-test ( i j -- flag ) \ Compares record i with record j
\ Convert the initial unordered array into a heap
: create-heap ( #records -- )
1+ 2
do i 0 rec-copy i ( node# )
begin dup 2/ 0 over rec-test ( node# parent flag )
while tuck swap rec-copy ( parent )
repeat ( node# parent )
drop 0 swap rec-copy
loop ;
\ Reconstruct the heap by inserting the record stored in the temporary
\ location 0. The root of the heap is empty because we extracted it and
\ put it at location rec#. We descend the tree, copying records up into
\ vacated spaces, until we find the place where the temporary record fits.
variable more?
: fix-heap ( max-rec# -- )
1 ( rec# parent )
more? on
begin ( rec# parent ) 2dup 2* 1+ >= \ Exit if we have reached a leaf node
\ or if the previous iteration found the right place for the key
more? @ and
while ( rec# parent ) dup 2* ( rec# parent left-child )
\ If the parent node has more than one child, find the largest one
2 pick over 1+ >
if dup dup 1+ swap rec-test if 1+ then then
\ Do we have to move the child up?
dup 0 rec-test ( rec# parent child flag )
if tuck swap rec-copy ( rec# child )
else drop more? off ( rec# parent )
then
repeat ( rec# parent' )
0 swap rec-copy drop ;
: heap-sort ( #records -- )
dup create-heap ( #records )
\ Now the array is a heap. Repeatedly extract the root node of the
\ heap, put it in its correct place in the output array, and reconstruct
\ the heap by inserting the displaced record back into the heap.
begin ( rec# )
\ Loop Invariant: The array from [1..rec#] is a heap.
\ The arrary from [rec#..#records] is sorted in ascending order.
dup 2 >=
while ( rec# )
dup 0 rec-copy \ Save record[rec#] in temporary location 0
1 over rec-copy \ Replace it with the record from the root of the heap
dup fix-heap ( rec# )
1-
repeat
drop ;